home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-08-20 | 71.1 KB | 97 lines | [ TEXT/CCL ]
(export (quote (mlispprogram mlispfunction reparsemlisp)) :glisp) (glisp::declarereservedwords (quote mlisp) (quote (also begin by case ccase collect constant ctypecase defmacro defobfun defun do ecase else end etypecase for global if in lambda let let* mlisp new of on return then to typecase until while))) (addrules (quote glisplanguage) (quote (((literal -) (literal mlisp) (literal -) (call mlispprogram) (variable 1) (rewritesto) (variable 1)))) nil) (defpfun mlispprogram nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote mlispprogram)) (glisp::lcall (quote sourcelanguage) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote mlisp))) (cdr glisp::!dest)) nil) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::lcall (quote expression) nil nil) (glisp::slvariable 2) (or (nextis? (quote \;)) (failure "';'")) (glisp::lcall (quote flush) nil nil) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 2) (glisp::endplispfunction (quote mlispprogram))) ((call sourcelanguage ((literal mlisp))) (repeat 1 0 ((call expression) (variable 2) (literal \;) (call flush))) (rewritesto) (variable 2))) (defpfun expression nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote expression)) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (> glisp::!repeatcount 1) (catch !failure (or (nextis? (quote also)) (failure "'also'")) nil) (glisp::restoredecisionpoint)) (and (catch !failure (glisp::lcall (quote precedence) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote 0))) (glisp::rcall (quote basicexpression) nil nil) (cdr glisp::!dest)) nil) (glisp::slvariable 2) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 1)) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote makeprogn) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 2) (cdr glisp::!dest)) nil) (glisp::endplispfunction (quote expression))) ((repeat 1 1 ((call precedence ((literal 0) (call basicexpression))) (variable 2)) ((literal also))) (rewritesto) (call makeprogn ((variable 2))))) (defpfun basicexpression nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote basicexpression)) (glisp::setdecisionpoint) (and (catch !failure (case (peek) (begin (next) (glisp::lcall (quote blockdeclarations) nil nil) (glisp::slvariable 1) (glisp::lcall (quote expressions) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote \;))) (cdr glisp::!dest)) nil) (glisp::slvariable 2) (or (nextis? (quote end)) (failure "'end'")) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote prog))) (glisp::srvariable 1) (glisp::mrvariable 2) (glisp::rendlist)) (if (next) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (or (nextis? (quote then)) (failure "'then'")) (glisp::lcall (quote condclause) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) (glisp::slvariable 2) (glisp::setdecisionpoint) (and (catch !failure (or (nextis? (quote else)) (failure "'else'")) (glisp::lcall (quote condclause) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote t))) (cdr glisp::!dest)) nil) (glisp::setdecisionpoint) (and (catch !failure (glisp::lbeginlist) (or (nextis? (quote t)) (failure "'t'")) (glisp::lbeginlist) (or (nextis? (quote cond)) (failure "'cond'")) (glisp::mlvariable 3 t t) (glisp::lendlist) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote cond))) (glisp::srvariable 2) (glisp::mrvariable 3) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote cond))) (glisp::srvariable 2) (glisp::srvariable 3) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or :3" t)) (glisp::deletedecisionpoint) nil) (glisp::restoredecisionpoint) (catch !failure (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote cond))) (glisp::srvariable 2) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'else' or nothing" t)) (glisp::deletedecisionpoint)) (return (next) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote return))) (glisp::srvariable 1) (glisp::rendlist)) (do (next) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote until)) (failure "'until'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (or (nextis? (quote while)) (failure "'while'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'until' or 'while'" t))) (glisp::deletedecisionpoint)) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote do))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote nil))) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::srvariable 1) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote cond))) (glisp::rbeginlist) (case (glisp::altcheck 2) (1 (glisp::srvariable 3)) (2 (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote not))) (glisp::srvariable 3) (glisp::rendlist)) (t (failure ":3 or '('"))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote return))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rendlist) (glisp::rendlist) (glisp::rendlist)) (collect (next) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote until)) (failure "'until'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (or (nextis? (quote while)) (failure "'while'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'until' or 'while'" t))) (glisp::deletedecisionpoint)) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote do))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote nil))) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rbeginlist) (glisp::rcall (quote collectfunction) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::srvariable 1) (glisp::rendlist) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote cond))) (glisp::rbeginlist) (case (glisp::altcheck 2) (1 (glisp::srvariable 3)) (2 (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote not))) (glisp::srvariable 3) (glisp::rendlist)) (t (failure ":3 or '('"))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote return))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rendlist) (glisp::rendlist) (glisp::rendlist)) (until (next) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote do)) (failure "'do'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (or (nextis? (quote collect)) (failure "'collect'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'do' or 'collect'" t))) (glisp::deletedecisionpoint)) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote do))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote return))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (case (glisp::altcheck 2) (1 (glisp::srvariable 3)) (2 (glisp::rbeginlist) (glisp::rcall (quote collectfunction) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 3) (cdr glisp::!dest)) nil) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::srvariable 3) (glisp::rendlist)) (t (failure ":3 or '('"))) (glisp::rendlist) (glisp::rendlist)) (while (next) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote do)) (failure "'do'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (or (nextis? (quote collect)) (failure "'collect'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'do' or 'collect'" t))) (glisp::deletedecisionpoint)) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote do))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rbeginlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote not))) (glisp::srvariable 1) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote return))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rendlist) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (case (glisp::altcheck 2) (1 (glisp::srvariable 3)) (2 (glisp::rbeginlist) (glisp::rcall (quote collectfunction) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 3) (cdr glisp::!dest)) nil) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::srvariable 3) (glisp::rendlist)) (t (failure ":3 or '('"))) (glisp::rendlist) (glisp::rendlist)) (for (next) (glisp::lcall (quote forclauses) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote for))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote do)) (failure "'do'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (or (nextis? (quote collect)) (failure "'collect'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'do' or 'collect'" t))) (glisp::deletedecisionpoint)) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 3) (let ((glisp::altvar (and (glisp::vbound? 4) (not glisp::!inrepeat) (glisp::veval 4 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote until)) (failure "'until'")) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 5) nil) (glisp::restoredecisionpoint))) (glisp::vset 4 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (or (nextis? (quote while)) (failure "'while'")) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 5) nil) (glisp::restoredecisionpoint))) (glisp::vset 4 2 nil)) (and (or (null glisp::altvar) (= glisp::altvar 3)) (glisp::vset 4 3 nil)) (progn (glisp::deletedecisionpoint) (failure "'until' or 'while' or something" t))) (glisp::deletedecisionpoint)) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote translatefor) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (case (glisp::altcheck 2) (1 (setq glisp::!dest (glisp::xcons glisp::!dest (quote prog2)))) (2 (glisp::rcall (quote collectfunction) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 3) (cdr glisp::!dest)) nil)) (t (failure "'prog2' or <collectfunction>"))) (glisp::srvariable 3) (case (glisp::altcheck 4) (1 (glisp::srvariable 5)) (2 (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote not))) (glisp::srvariable 5) (glisp::rendlist)) (3 (setq glisp::!dest (glisp::xcons glisp::!dest (quote nil)))) (t (failure ":5 or '(' or 'nil'"))) (cdr glisp::!dest)) nil)) (lambda (next) (glisp::lcall (quote lambdabody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote lambda))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote \;)) (failure "';'")) (or (nextis? (quote \()) (failure "'('")) (glisp::lcall (quote arguments) nil nil) (glisp::slvariable 3) (or (nextis? (quote \))) (failure "')'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "';' or something" t))) (glisp::deletedecisionpoint)) (setq glisp::!dest (glisp::xnew)) (case (glisp::altcheck 2) (1 (glisp::rbeginlist) (glisp::srvariable 1) (glisp::mrvariable 3) (glisp::rendlist)) (2 (glisp::srvariable 1)) (t (failure "'(' or :1")))) (let (next) (glisp::lcall (quote lambdabody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote let))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (let* (next) (glisp::lcall (quote lambdabody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote let*))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (defun (next) (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 1) (glisp::lcall (quote checkfunction) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) (glisp::lcall (quote lambdabody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote lambda))) (cdr glisp::!dest)) nil) (glisp::lbeginlist) (or (nextis? (quote lambda)) (failure "'lambda'")) (glisp::mlvariable 2 t t) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote defun))) (glisp::srvariable 1) (glisp::mrvariable 2) (glisp::rendlist)) (defmacro (next) (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 1) (glisp::lcall (quote checkfunction) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) (glisp::lcall (quote lambdabody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote lambda))) (cdr glisp::!dest)) nil) (glisp::lbeginlist) (or (nextis? (quote lambda)) (failure "'lambda'")) (glisp::mlvariable 2 t t) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote defmacro))) (glisp::srvariable 1) (glisp::mrvariable 2) (glisp::rendlist)) (defobfun (next) (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 1) (or (nextis? (quote \()) (failure "'('")) (glisp::lcall (quote identifier) nil nil) (glisp::slvariable 2) (or (nextis? (quote \))) (failure "')'")) (glisp::lcall (quote checkfunction) (let ((glisp::!dest (glisp::xnew))) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) (cdr glisp::!dest)) nil) (glisp::lcall (quote lambdabody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote lambda))) (cdr glisp::!dest)) nil) (glisp::lbeginlist) (or (nextis? (quote lambda)) (failure "'lambda'")) (glisp::mlvariable 3 t t) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote defobfun))) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) (glisp::mrvariable 3) (glisp::rendlist)) (case (next) (glisp::lcall (quote casebody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote case))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (ccase (next) (glisp::lcall (quote casebody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote ccase))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (ecase (next) (glisp::lcall (quote casebody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote ecase))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (typecase (next) (glisp::lcall (quote casebody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote typecase))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (ctypecase (next) (glisp::lcall (quote casebody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote ctypecase))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (etypecase (next) (glisp::lcall (quote casebody) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote etypecase))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (global (next) (glisp::lcall (quote globalvariables) nil nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (constant (next) (glisp::lcall (quote aconstant) nil nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) (t (failure "'begin' or 'if' or 'return' or 'do' or 'collect' or 'until' or 'while' or 'for' or 'lambda' or 'let' or 'let*' or 'defun' or 'defmacro' or 'defobfun' or 'case' or 'ccase' or 'ecase' or 'typecase' or 'ctypecase' or 'etypecase' or 'global' or 'constant'"))) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::lcall (quote prefixes) nil nil) (glisp::slvariable 1) (glisp::lcall (quote primitive) nil nil) (glisp::lcall (quote qualifiers) nil nil) (glisp::slvariable 2) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote composition) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (glisp::srvariable 2) (cdr glisp::!dest)) nil) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'begin' or 'if' or 'return' or 'do' or 'collect' or 'until' or 'while' or 'for' or 'lambda' or 'let' or 'let*' or 'defun' or 'defmacro' or 'defobfun' or 'case' or 'ccase' or 'ecase' or 'typecase' or 'ctypecase' or 'etypecase' or 'global' or 'constant' or <prefixes>" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote basicexpression))) ((branches ((literals (begin (call blockdeclarations) (variable 1) (call expressions ((literal \;))) (variable 2) (literal end) (rewritesto) (beginlist) (literal prog) (variable 1) (variable 2 t ((endlist)))) (if (call expression) (variable 1) (literal then) (call condclause ((variable 1))) (variable 2) (branches ((literal else) (call condclause ((literal t))) (branches ((beginlist) (literal t) (beginlist) (literal cond) (variable 3 t ((endlist))) (endlist) (rewritesto) (beginlist) (literal cond) (variable 2) (variable 3 t ((endlist)))) ((variable 3) (rewritesto) (beginlist) (literal cond) (variable 2) (variable 3) (endlist)))) ((rewritesto) (beginlist) (literal cond) (variable 2) (endlist)))) (return (call expression) (variable 1) (rewritesto) (beginlist) (literal return) (variable 1) (endlist)) (do (call expression) (variable 1) (alternatives 2 ((literal until)) ((literal while))) (call expression) (variable 3) (rewritesto) (beginlist) (literal do) (beginlist) (literal &v) (endlist) (beginlist) (literal nil) (endlist) (beginlist) (literal setq) (literal &v) (variable 1) (endlist) (beginlist) (literal cond) (beginlist) (alternatives 2 ((variable 3)) ((beginlist) (literal not) (variable 3) (endlist))) (beginlist) (literal return) (literal &v) (endlist) (endlist) (endlist) (endlist)) (collect (call expression) (variable 1) (alternatives 2 ((literal until)) ((literal while))) (call expression) (variable 3) (rewritesto) (beginlist) (literal do) (beginlist) (literal &v) (endlist) (beginlist) (literal nil) (endlist) (beginlist) (literal setq) (literal &v) (beginlist) (call collectfunction ((variable 1))) (literal &v) (variable 1) (endlist) (endlist) (beginlist) (literal cond) (beginlist) (alternatives 2 ((variable 3)) ((beginlist) (literal not) (variable 3) (endlist))) (beginlist) (literal return) (literal &v) (endlist) (endlist) (endlist) (endlist)) (until (call expression) (variable 1) (alternatives 2 ((literal do)) ((literal collect))) (call expression) (variable 3) (rewritesto) (beginlist) (literal do) (beginlist) (literal &v) (endlist) (beginlist) (variable 1) (beginlist) (literal return) (literal &v) (endlist) (endlist) (beginlist) (literal setq) (literal &v) (alternatives 2 ((variable 3)) ((beginlist) (call collectfunction ((variable 3))) (literal &v) (variable 3) (endlist))) (endlist) (endlist)) (while (call expression) (variable 1) (alternatives 2 ((literal do)) ((literal collect))) (call expression) (variable 3) (rewritesto) (beginlist) (literal do) (beginlist) (literal &v) (endlist) (beginlist) (beginlist) (literal not) (variable 1) (endlist) (beginlist) (literal return) (literal &v) (endlist) (endlist) (beginlist) (literal setq) (literal &v) (alternatives 2 ((variable 3)) ((beginlist) (call collectfunction ((variable 3))) (literal &v) (variable 3) (endlist))) (endlist) (endlist)) (for (call forclauses ((literal for))) (variable 1) (alternatives 2 ((literal do)) ((literal collect))) (call expression) (variable 3) (alternatives 4 ((literal until) (call expression) (variable 5)) ((literal while) (call expression) (variable 5)) nil) (rewritesto) (call translatefor ((variable 1) (alternatives 2 ((literal prog2)) ((call collectfunction ((variable 3))))) (variable 3) (alternatives 4 ((variable 5)) ((beginlist) (literal not) (variable 5) (endlist)) ((literal nil)))))) (lambda (call lambdabody ((literal lambda))) (variable 1) (alternatives 2 ((literal \;) (literal \() (call arguments) (variable 3) (literal \))) nil) (rewritesto) (alternatives 2 ((beginlist) (variable 1) (variable 3 t ((endlist)))) ((variable 1)))) (let (call lambdabody ((literal let))) (variable 1) (rewritesto) (variable 1)) (let* (call lambdabody ((literal let*))) (variable 1) (rewritesto) (variable 1)) (defun (call nonreservedword) (variable 1) (call checkfunction ((variable 1))) (call lambdabody ((literal lambda))) (beginlist) (literal lambda) (variable 2 t ((endlist))) (rewritesto) (beginlist) (literal defun) (variable 1) (variable 2 t ((endlist)))) (defmacro (call nonreservedword) (variable 1) (call checkfunction ((variable 1))) (call lambdabody ((literal lambda))) (beginlist) (literal lambda) (variable 2 t ((endlist))) (rewritesto) (beginlist) (literal defmacro) (variable 1) (variable 2 t ((endlist)))) (defobfun (call nonreservedword) (variable 1) (literal \() (call identifier) (variable 2) (literal \)) (call checkfunction ((beginlist) (variable 1) (variable 2) (endlist))) (call lambdabody ((literal lambda))) (beginlist) (literal lambda) (variable 3 t ((endlist))) (rewritesto) (beginlist) (literal defobfun) (beginlist) (variable 1) (variable 2) (endlist) (variable 3 t ((endlist)))) (case (call casebody ((literal case))) (variable 1) (rewritesto) (variable 1)) (ccase (call casebody ((literal ccase))) (variable 1) (rewritesto) (variable 1)) (ecase (call casebody ((literal ecase))) (variable 1) (rewritesto) (variable 1)) (typecase (call casebody ((literal typecase))) (variable 1) (rewritesto) (variable 1)) (ctypecase (call casebody ((literal ctypecase))) (variable 1) (rewritesto) (variable 1)) (etypecase (call casebody ((literal etypecase))) (variable 1) (rewritesto) (variable 1)) (global (call globalvariables) (variable 1) (rewritesto) (variable 1)) (constant (call aconstant) (variable 1) (rewritesto) (variable 1)))) ((call prefixes) (variable 1) (call primitive) (call qualifiers) (variable 2) (rewritesto) (call composition ((variable 1) (variable 2))))))) (defpfun primitive nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote primitive)) (glisp::setdecisionpoint) (and (catch !failure (case (peek) (\' (next) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote quote))) (glisp::srvariable 1) (glisp::rendlist)) (\( (next) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (or (nextis? (quote \))) (failure "')'")) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1)) ({ (next) (glisp::lcall (quote expressions) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote \,))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (or (nextis? (quote })) (failure "'}'")) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote list))) (glisp::mrvariable 1) (glisp::rendlist)) (\: (next) (glisp::lcall (quote identifier) nil nil) (glisp::slvariable 1) (glisp::lcall (quote pvariable) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (setq glisp::!dest (glisp::xcons glisp::!dest (quote t))) (cdr glisp::!dest)) nil) (glisp::slvariable 2) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote veval))) (glisp::srvariable 2) (glisp::rendlist)) (t (failure "''' or '(' or '{' or ':'"))) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::lcall (quote nonreservedword) nil nil) (setq glisp::!dest (glisp::xnew)) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 1) (or (not (symbolp (glisp::veval 1))) (failure "anything but a symbol")) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "''' or '(' or '{' or ':' or <nonreservedword> or :1" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote primitive))) ((branches ((literals (\' (variable 1) (rewritesto) (beginlist) (literal quote) (variable 1) (endlist)) (\( (call expression) (variable 1) (literal \)) (rewritesto) (variable 1)) ({ (call expressions ((literal \,))) (variable 1) (literal }) (rewritesto) (beginlist) (literal list) (variable 1 t ((endlist)))) (\: (call identifier) (variable 1) (call pvariable ((variable 1) (literal t))) (variable 2) (rewritesto) (beginlist) (literal veval) (variable 2) (endlist)))) ((call nonreservedword) (rewritesto)) ((variable 1) (lisp if (not (symbolp (glisp::veval 1))) "anything but a symbol") (rewritesto) (variable 1))))) (defpfun qualifiers nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote qualifiers)) (glisp::slvariable 1) (glisp::setdecisionpoint) (and (catch !failure (case (peek) (\( (next) (glisp::lcall (quote arguments) nil nil) (glisp::slvariable 2) (or (nextis? (quote \))) (failure "')'")) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote qualifiers) (let ((glisp::!dest (glisp::xnew))) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::mrvariable 2) (glisp::rendlist) (cdr glisp::!dest)) nil)) ([ (next) (glisp::lcall (quote expressions) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote \,))) (cdr glisp::!dest)) nil) (glisp::slvariable 2) (or (nextis? (quote ])) (failure "']'")) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote qualifiers) (let ((glisp::!dest (glisp::xnew))) (glisp::rcall (quote translateindex) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (glisp::srvariable 2) (cdr glisp::!dest)) nil) (cdr glisp::!dest)) nil)) (\. (next) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (glisp::lcall (quote identifier) nil nil) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (glisp::lcall (quote primitive) nil nil) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "<identifier> or <primitive>" t))) (glisp::deletedecisionpoint)) (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote qualifiers) (let ((glisp::!dest (glisp::xnew))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote get))) (glisp::srvariable 1) (case (glisp::altcheck 2) (1 (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote quote))) (glisp::srvariable 3) (glisp::rendlist)) (2 (glisp::srvariable 3)) (t (failure "'(' or :3"))) (glisp::rendlist) (cdr glisp::!dest)) nil)) (\:= (next) (glisp::lcall (quote simpleexpression) nil nil) (glisp::slvariable 2) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setf))) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist)) (t (failure "'(' or '[' or '.' or ':='"))) nil) (glisp::restoredecisionpoint) (catch !failure (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or '[' or '.' or ':=' or nothing" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote qualifiers))) ((variable 1) (branches ((literals (\( (call arguments) (variable 2) (literal \)) (rewritesto) (call qualifiers ((beginlist) (variable 1) (variable 2 t ((endlist)))))) ([ (call expressions ((literal \,))) (variable 2) (literal ]) (rewritesto) (call qualifiers ((call translateindex ((variable 1) (variable 2)))))) (\. (alternatives 2 ((call identifier)) ((call primitive))) (variable 3) (rewritesto) (call qualifiers ((beginlist) (literal get) (variable 1) (alternatives 2 ((beginlist) (literal quote) (variable 3) (endlist)) ((variable 3))) (endlist)))) (\:= (call simpleexpression) (variable 2) (rewritesto) (beginlist) (literal setf) (variable 1) (variable 2) (endlist)))) ((rewritesto) (variable 1))))) (defpfun simpleexpression nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote simpleexpression)) (glisp::lcall (quote precedence) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote 0))) (glisp::rcall (quote basicexpression) nil nil) (cdr glisp::!dest)) nil) (setq glisp::!dest (glisp::xnew)) (glisp::endplispfunction (quote simpleexpression))) ((call precedence ((literal 0) (call basicexpression))) (rewritesto))) (defpfun blockdeclarations nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote blockdeclarations)) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::lcall (quote blockdeclaration) nil nil) (glisp::slvariable 2) (or (nextis? (quote \;)) (failure "';'")) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::mrvariable 2) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (glisp::rendlist) (glisp::endplispfunction (quote blockdeclarations))) ((repeat 1 0 ((call blockdeclaration) (variable 2) (literal \;))) (rewritesto) (beginlist) (repeat 1 0 ((variable 2 t nil))) (endlist))) (defpfun blockdeclaration nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote blockdeclaration)) (or (nextis? (quote new)) (failure "'new'")) (glisp::lcall (quote variables) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote nil))) (cdr glisp::!dest)) nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) (glisp::endplispfunction (quote blockdeclaration))) ((literal new) (call variables ((literal nil))) (variable 1) (rewritesto) (variable 1))) (defpfun lambdabody nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote lambdabody)) (glisp::slvariable 1) (or (nextis? (quote \()) (failure "'('")) (glisp::lcall (quote variables) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote t))) (cdr glisp::!dest)) nil) (glisp::slvariable 2) (or (nextis? (quote \))) (failure "')'")) (or (nextis? (quote =)) (failure "'='")) (glisp::lcall (quote expression) nil nil) (glisp::setdecisionpoint) (and (catch !failure (glisp::lbeginlist) (or (nextis? (quote progn)) (failure "'progn'")) (glisp::mlvariable 3 t t) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::mrvariable 3) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::srvariable 3) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or :3" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote lambdabody))) ((variable 1) (literal \() (call variables ((literal t))) (variable 2) (literal \)) (literal =) (call expression) (branches ((beginlist) (literal progn) (variable 3 t ((endlist))) (rewritesto) (beginlist) (variable 1) (variable 2) (variable 3 t ((endlist)))) ((variable 3) (rewritesto) (beginlist) (variable 1) (variable 2) (variable 3) (endlist))))) (defpfun condclause nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote condclause)) (glisp::slvariable 1) (glisp::lcall (quote expression) nil nil) (glisp::setdecisionpoint) (and (catch !failure (glisp::lbeginlist) (or (nextis? (quote progn)) (failure "'progn'")) (glisp::mlvariable 2 t t) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::mrvariable 2) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 2) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or :2" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote condclause))) ((variable 1) (call expression) (branches ((beginlist) (literal progn) (variable 2 t ((endlist))) (rewritesto) (beginlist) (variable 1) (variable 2 t ((endlist)))) ((variable 2) (rewritesto) (beginlist) (variable 1) (variable 2) (endlist))))) (defpfun forclauses nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote forclauses)) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::lcall (quote forclause) nil nil) (glisp::slvariable 2) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 2) (glisp::endplispfunction (quote forclauses))) ((repeat 1 0 ((call forclause) (variable 2))) (rewritesto) (variable 2))) (defpfun forclause nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote forclause)) (or (nextis? (quote for)) (failure "'for'")) (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 1) (glisp::setdecisionpoint) (and (catch !failure (or (nextis? (quote \:=)) (failure "':='")) (glisp::lcall (quote simpleexpression) nil nil) (glisp::slvariable 2) (or (nextis? (quote to)) (failure "'to'")) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 3) (let ((glisp::altvar (and (glisp::vbound? 4) (not glisp::!inrepeat) (glisp::veval 4 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote by)) (failure "'by'")) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 5) nil) (glisp::restoredecisionpoint))) (glisp::vset 4 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (glisp::vset 4 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'by' or something" t))) (glisp::deletedecisionpoint)) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (setq glisp::!dest (glisp::xcons glisp::!dest (quote \:=))) (glisp::srvariable 2) (glisp::srvariable 3) (case (glisp::altcheck 4) (1 (glisp::srvariable 5)) (2 (setq glisp::!dest (glisp::xcons glisp::!dest (quote 1)))) (t (failure ":5 or '1'"))) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote in)) (failure "'in'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (or (nextis? (quote on)) (failure "'on'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'in' or 'on'" t))) (glisp::deletedecisionpoint)) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (case (glisp::altcheck 2) (1 (setq glisp::!dest (glisp::xcons glisp::!dest (quote in)))) (2 (setq glisp::!dest (glisp::xcons glisp::!dest (quote on)))) (t (failure "'in' or 'on'"))) (glisp::srvariable 3) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "':=' or 'in' or 'on'" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote forclause))) ((literal for) (call nonreservedword) (variable 1) (branches ((literal \:=) (call simpleexpression) (variable 2) (literal to) (call expression) (variable 3) (alternatives 4 ((literal by) (call expression) (variable 5)) nil) (rewritesto) (beginlist) (variable 1) (literal \:=) (variable 2) (variable 3) (alternatives 4 ((variable 5)) ((literal 1))) (endlist)) ((alternatives 2 ((literal in)) ((literal on))) (call expression) (variable 3) (rewritesto) (beginlist) (variable 1) (alternatives 2 ((literal in)) ((literal on))) (variable 3) (endlist))))) (defpfun translatefor nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote translatefor)) (glisp::slvariable 1) (glisp::slvariable 2) (glisp::slvariable 3) (let ((glisp::altvar (and (glisp::vbound? 6) (not glisp::!inrepeat) (glisp::veval 6 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote nil)) (failure "'nil'")) nil) (glisp::restoredecisionpoint))) (glisp::vset 6 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (not (and (catch !failure (glisp::slvariable 5) nil) (glisp::restoredecisionpoint))) (glisp::vset 6 2 nil)) (progn (glisp::deletedecisionpoint) (failure "'nil' or :5" t))) (glisp::deletedecisionpoint)) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote do))) (glisp::rbeginlist) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 4))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::rcall (quote forvariable) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 4 0)) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rbeginlist) (glisp::rcall (quote forstoptest) (let ((glisp::!dest (glisp::xnew))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote or))) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 7))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::rcall (quote forstop) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 7 0)) (glisp::rendlist) (cdr glisp::!dest)) nil) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 8))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::rcall (quote setforvariable) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 8 0)) (glisp::rcall (quote setforvalue) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 3) (glisp::srvariable 2) (cdr glisp::!dest)) nil) (case (glisp::altcheck 6) (1) (2 (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote if))) (glisp::srvariable 5) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote return))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rendlist) (glisp::rendlist)) (t (failure "something or '('"))) (glisp::rendlist) (glisp::endplispfunction (quote translatefor))) ((variable 1) (variable 2) (variable 3) (alternatives 6 ((literal nil)) ((variable 5))) (rewritesto) (beginlist) (literal do) (beginlist) (repeat 4 0 ((call forvariable ((variable 1))))) (literal &v) (endlist) (beginlist) (call forstoptest ((beginlist) (literal or) (repeat 7 0 ((call forstop ((variable 1))))) (endlist))) (literal &v) (endlist) (repeat 8 0 ((call setforvariable ((variable 1))))) (call setforvalue ((variable 3) (variable 2))) (alternatives 6 nil ((beginlist) (literal if) (variable 5) (beginlist) (literal return) (literal &v) (endlist) (endlist))) (endlist))) (defpfun forvariable nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote forvariable)) (glisp::lbeginlist) (glisp::slvariable 1) (case (peek) (in (next) (glisp::slvariable 2) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (setf (glisp::veval 3) (intern (cat "&" (cat (glisp::veval 1) "&")))) (glisp::srvariable 1) (glisp::rbeginlist) (glisp::srvariable 3) (glisp::srvariable 2) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote cdr))) (glisp::srvariable 3) (glisp::rendlist) (glisp::rendlist)) (on (next) (glisp::slvariable 2) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote cdr))) (glisp::srvariable 1) (glisp::rendlist) (glisp::rendlist)) (\:= (next) (glisp::slvariable 2) (glisp::slvariable 3) (glisp::slvariable 4) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote numericforvariable) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::srvariable 3) (glisp::srvariable 4) (cdr glisp::!dest)) t)) (t (failure "'in' or 'on' or ':='"))) (glisp::endplispfunction (quote forvariable))) ((beginlist) (variable 1) (literals (in (variable 2) (endlist) (rewritesto) (lisp do (setf (glisp::veval 3) (intern (cat "&" (cat (glisp::veval 1) "&"))))) (variable 1) (beginlist) (variable 3) (variable 2) (beginlist) (literal cdr) (variable 3) (endlist) (endlist)) (on (variable 2) (endlist) (rewritesto) (beginlist) (variable 1) (variable 2) (beginlist) (literal cdr) (variable 1) (endlist) (endlist)) (\:= (variable 2) (variable 3) (variable 4) (endlist) (rewritesto) (call numericforvariable ((variable 1) (variable 2) (variable 3) (variable 4)) t))))) (defpfun forstop nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote forstop)) (glisp::lbeginlist) (glisp::slvariable 1) (case (peek) (in (next) (glisp::slvariable 2) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote atom))) (setq glisp::!dest (glisp::xcons glisp::!dest (intern (cat "&" (cat (glisp::veval 1) "&"))))) (glisp::rendlist)) (on (next) (glisp::slvariable 2) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote atom))) (glisp::srvariable 1) (glisp::rendlist)) (\:= (next) (glisp::slvariable 2) (glisp::slvariable 3) (glisp::slvariable 4) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote numericforstoptest) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (glisp::srvariable 3) (glisp::srvariable 4) (cdr glisp::!dest)) t)) (t (failure "'in' or 'on' or ':='"))) (glisp::endplispfunction (quote forstop))) ((beginlist) (variable 1) (literals (in (variable 2) (endlist) (rewritesto) (beginlist) (literal atom) (lisp value (intern (cat "&" (cat (glisp::veval 1) "&"))) nil) (endlist)) (on (variable 2) (endlist) (rewritesto) (beginlist) (literal atom) (variable 1) (endlist)) (\:= (variable 2) (variable 3) (variable 4) (endlist) (rewritesto) (call numericforstoptest ((variable 1) (variable 3) (variable 4)) t))))) (defpfun forstoptest nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote forstoptest)) (glisp::setdecisionpoint) (and (catch !failure (glisp::lbeginlist) (or (nextis? (quote or)) (failure "'or'")) (glisp::slvariable 1) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or :1" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote forstoptest))) ((branches ((beginlist) (literal or) (variable 1) (endlist) (rewritesto) (variable 1)) ((variable 1) (rewritesto) (variable 1))))) (defpfun setforvariable nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote setforvariable)) (glisp::setdecisionpoint) (and (catch !failure (glisp::lbeginlist) (glisp::slvariable 1) (or (nextis? (quote in)) (failure "'in'")) (glisp::slvariable 2) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (glisp::srvariable 1) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote car))) (setq glisp::!dest (glisp::xcons glisp::!dest (intern (cat "&" (cat (glisp::veval 1) "&"))))) (glisp::rendlist) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or :1" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote setforvariable))) ((branches ((beginlist) (variable 1) (literal in) (variable 2) (endlist) (rewritesto) (beginlist) (literal setq) (variable 1) (beginlist) (literal car) (lisp value (intern (cat "&" (cat (glisp::veval 1) "&"))) nil) (endlist) (endlist)) ((variable 1) (rewritesto))))) (defpfun setforvalue nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote setforvalue)) (glisp::setdecisionpoint) (and (catch !failure (or (nextis? (quote nil)) (failure "'nil'")) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 1) (glisp::setdecisionpoint) (and (catch !failure (or (nextis? (quote prog2)) (failure "'prog2'")) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::srvariable 1) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 2) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::rbeginlist) (glisp::srvariable 2) (setq glisp::!dest (glisp::xcons glisp::!dest (quote &v))) (glisp::srvariable 1) (glisp::rendlist) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'prog2' or :2" t)) (glisp::deletedecisionpoint) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'nil' or :1" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote setforvalue))) ((branches ((literal nil) (variable 1) (rewritesto)) ((variable 1) (branches ((literal prog2) (rewritesto) (beginlist) (literal setq) (literal &v) (variable 1) (endlist)) ((variable 2) (rewritesto) (beginlist) (literal setq) (literal &v) (beginlist) (variable 2) (literal &v) (variable 1) (endlist) (endlist))))))) (defpfun collectfunction nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote collectfunction)) (glisp::setdecisionpoint) (and (catch !failure (glisp::lbeginlist) (or (nextis? (quote list)) (failure "'list'")) (glisp::mlvariable 1 t t) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (setq glisp::!dest (glisp::xcons glisp::!dest (quote nconc))) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (setq glisp::!dest (glisp::xcons glisp::!dest (quote append))) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or :1" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote collectfunction))) ((branches ((beginlist) (literal list) (variable 1 t ((endlist))) (rewritesto) (literal nconc)) ((variable 1) (rewritesto) (literal append))))) (defpfun casebody nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote casebody)) (glisp::slvariable 1) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 2) (or (nextis? (quote of)) (failure "'of'")) (or (nextis? (quote begin)) (failure "'begin'")) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 3))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::lcall (quote caseclause) nil nil) (glisp::slvariable 4) (or (nextis? (quote \;)) (failure "';'")) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 3 0)) (or (nextis? (quote end)) (failure "'end'")) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::mrvariable 4) (glisp::rendlist) (glisp::endplispfunction (quote casebody))) ((variable 1) (call expression) (variable 2) (literal of) (literal begin) (repeat 3 0 ((call caseclause) (variable 4) (literal \;))) (literal end) (rewritesto) (beginlist) (variable 1) (variable 2) (variable 4 t ((endlist))))) (defpfun caseclause nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote caseclause)) (glisp::slvariable 1) (or (nextis? (quote \:)) (failure "':'")) (glisp::lcall (quote expression) nil nil) (glisp::setdecisionpoint) (and (catch !failure (glisp::lbeginlist) (or (nextis? (quote progn)) (failure "'progn'")) (glisp::mlvariable 2 t t) (glisp::lendlist) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::mrvariable 2) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::slvariable 2) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "'(' or :2" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote caseclause))) ((variable 1) (literal \:) (call expression) (branches ((beginlist) (literal progn) (variable 2 t ((endlist))) (rewritesto) (beginlist) (variable 1) (variable 2 t ((endlist)))) ((variable 2) (rewritesto) (beginlist) (variable 1) (variable 2) (endlist))))) (defpfun globalvariables nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote globalvariables)) (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 1) (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote \:=)) (failure "':='")) (glisp::lcall (quote simpleexpression) nil nil) (glisp::slvariable 3) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "':=' or something" t))) (glisp::deletedecisionpoint)) (let ((glisp::altvar (and (glisp::vbound? 4) (not glisp::!inrepeat) (glisp::veval 4 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote \,)) (failure "','")) nil) (glisp::restoredecisionpoint))) (glisp::vset 4 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (glisp::vset 4 2 nil)) (progn (glisp::deletedecisionpoint) (failure "',' or something" t))) (glisp::deletedecisionpoint)) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote proclaim))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote quote))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote special))) (glisp::srvariable 1) (glisp::rendlist) (glisp::rendlist) (glisp::rendlist) (case (glisp::altcheck 2) (1 (setq glisp::!dest (glisp::xcons glisp::!dest (quote \;))) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote setq))) (glisp::srvariable 1) (glisp::srvariable 3) (glisp::rendlist)) (2) (t (failure "';' or something"))) (case (glisp::altcheck 4) (1 (setq glisp::!dest (glisp::xcons glisp::!dest (quote \;))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote global)))) (2) (t (failure "';' or something"))) (glisp::endplispfunction (quote globalvariables))) ((call nonreservedword) (variable 1) (alternatives 2 ((literal \:=) (call simpleexpression) (variable 3)) nil) (alternatives 4 ((literal \,)) nil) (rewritesto) (beginlist) (literal proclaim) (beginlist) (literal quote) (beginlist) (literal special) (variable 1) (endlist) (endlist) (endlist) (alternatives 2 ((literal \;) (beginlist) (literal setq) (variable 1) (variable 3) (endlist)) nil) (alternatives 4 ((literal \;) (literal global)) nil))) (defpfun variables nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote variables)) (case (peek) ((t) (next) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (> glisp::!repeatcount 1) (catch !failure (or (nextis? (quote \,)) (failure "','")) nil) (glisp::restoredecisionpoint)) (and (catch !failure (let ((glisp::altvar (and (glisp::vbound? 2) (not glisp::!inrepeat) (glisp::veval 2 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (glisp::lcall (quote modifier) nil nil) nil) (glisp::restoredecisionpoint))) (glisp::vset 2 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (glisp::vset 2 2 nil)) (progn (glisp::deletedecisionpoint) (failure "<modifier> or something" t))) (glisp::deletedecisionpoint)) (glisp::lcall (quote avariable) nil nil) (glisp::slvariable 3) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 3)) ((nil) (next) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (> glisp::!repeatcount 1) (catch !failure (or (nextis? (quote \,)) (failure "','")) nil) (glisp::restoredecisionpoint)) (and (catch !failure (glisp::lcall (quote avariable) nil nil) (glisp::slvariable 2) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 2)) (t (failure "'t' or 'nil'"))) (glisp::endplispfunction (quote variables))) ((literals (t (repeat 1 0 ((alternatives 2 ((call modifier)) nil) (call avariable) (variable 3)) ((literal \,))) (rewritesto) (variable 3)) (nil (repeat 1 0 ((call avariable) (variable 2)) ((literal \,))) (rewritesto) (variable 2))))) (defpfun modifier nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote modifier)) (glisp::slvariable 1) (or (member (glisp::veval 1) lambda-list-keywords :test (function eq)) (failure "'(member (veval 1) lambda-list-keywords test #'eq)' to be true")) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) (setq glisp::!dest (glisp::xcons glisp::!dest (quote \,))) (glisp::endplispfunction (quote modifier))) ((variable 1) (lisp if (member (glisp::veval 1) lambda-list-keywords :test (function eq))) (rewritesto) (variable 1) (literal \,))) (defpfun avariable nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote avariable)) (glisp::setdecisionpoint) (and (catch !failure (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 1) (glisp::setdecisionpoint) (and (catch !failure (or (nextis? (quote \:=)) (failure "':='")) (glisp::lcall (quote simpleexpression) nil nil) (glisp::slvariable 2) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "':=' or nothing" t)) (glisp::deletedecisionpoint) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::lcall (quote akeyword) nil nil) (glisp::slvariable 1) (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 2) (glisp::setdecisionpoint) (and (catch !failure (or (nextis? (quote \:=)) (failure "':='")) (glisp::lcall (quote simpleexpression) nil nil) (glisp::slvariable 3) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) (glisp::srvariable 3) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (catch !failure (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "':=' or nothing" t)) (glisp::deletedecisionpoint) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "<nonreservedword> or <akeyword>" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote avariable))) ((branches ((call nonreservedword) (variable 1) (branches ((literal \:=) (call simpleexpression) (variable 2) (rewritesto) (beginlist) (variable 1) (variable 2) (endlist)) ((rewritesto) (variable 1)))) ((call akeyword) (variable 1) (call nonreservedword) (variable 2) (branches ((literal \:=) (call simpleexpression) (variable 3) (rewritesto) (beginlist) (beginlist) (variable 1) (variable 2) (endlist) (variable 3) (endlist)) ((rewritesto) (beginlist) (variable 1) (variable 2) (endlist))))))) (defpfun akeyword nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote akeyword)) (or (nextis? (quote \:)) (failure "':'")) (glisp::lcall (quote identifier) nil nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote makekeyword) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) (glisp::endplispfunction (quote akeyword))) ((literal \:) (call identifier) (variable 1) (rewritesto) (call makekeyword ((variable 1))))) (defpfun expressions nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote expressions)) (case (peek) (\; (next) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (catch !failure (glisp::lcall (quote expression) nil nil) (glisp::slvariable 2) (or (nextis? (quote \;)) (failure "';'")) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 2)) (\, (next) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (> glisp::!repeatcount 1) (catch !failure (or (nextis? (quote \,)) (failure "','")) nil) (glisp::restoredecisionpoint)) (and (catch !failure (glisp::lcall (quote expression) nil nil) (glisp::slvariable 2) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 2)) (t (failure "';' or ','"))) (glisp::endplispfunction (quote expressions))) ((literals (\; (repeat 1 0 ((call expression) (variable 2) (literal \;))) (rewritesto) (variable 2)) (\, (repeat 1 0 ((call expression) (variable 2)) ((literal \,))) (rewritesto) (variable 2))))) (defpfun arguments nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote arguments)) (let ((glisp::!inrepeat t) (glisp::!repeatcount 0) (max (glisp::repeatmax 1))) (loop (glisp::setdecisionpoint) (cond ((or (glisp::repeatstop? max) (and (> glisp::!repeatcount 1) (catch !failure (or (nextis? (quote \,)) (failure "','")) nil) (glisp::restoredecisionpoint)) (and (catch !failure (glisp::lcall (quote argument) nil nil) (glisp::slvariable 2) nil) (glisp::restoredecisionpoint))) (glisp::deletedecisionpoint) (return))) (glisp::deletedecisionpoint)) (glisp::repeatset 1 0)) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 2) (glisp::endplispfunction (quote arguments))) ((repeat 1 0 ((call argument) (variable 2)) ((literal \,))) (rewritesto) (variable 2))) (defpfun argument nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote argument)) (glisp::setdecisionpoint) (and (catch !failure (or (nextis? (quote \:)) (failure "':'")) (glisp::lcall (quote identifier) nil nil) (glisp::slvariable 1) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 2) (or (member (peek) (quote (\, \)))) (failure "'(member (peek) '(, )))' to be true")) (setq glisp::!dest (glisp::xnew)) (glisp::rcall (quote makekeyword) (let ((glisp::!dest (glisp::xnew))) (glisp::srvariable 1) (cdr glisp::!dest)) nil) (setq glisp::!dest (glisp::xcons glisp::!dest (quote \,))) (glisp::srvariable 2) nil) (glisp::restoredecisionpoint) (catch !failure (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) nil) (glisp::restoredecisionpoint) (glisp::deletedecisionpoint) (failure "':' or <expression>" t)) (glisp::deletedecisionpoint) (glisp::endplispfunction (quote argument))) ((branches ((literal \:) (call identifier) (variable 1) (call expression) (variable 2) (lisp if (member (peek) (quote (\, \))))) (rewritesto) (call makekeyword ((variable 1))) (literal \,) (variable 2)) ((call expression) (variable 1) (rewritesto) (variable 1))))) (defpfun aconstant nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote aconstant)) (glisp::lcall (quote nonreservedword) nil nil) (glisp::slvariable 1) (or (nextis? (quote \:=)) (failure "':='")) (glisp::lcall (quote simpleexpression) nil nil) (glisp::slvariable 2) (let ((glisp::altvar (and (glisp::vbound? 3) (not glisp::!inrepeat) (glisp::veval 3 nil)))) (glisp::setdecisionpoint) (or (and (or (null glisp::altvar) (= glisp::altvar 1)) (not (and (catch !failure (or (nextis? (quote \,)) (failure "','")) nil) (glisp::restoredecisionpoint))) (glisp::vset 3 1 nil)) (and (or (null glisp::altvar) (= glisp::altvar 2)) (glisp::vset 3 2 nil)) (progn (glisp::deletedecisionpoint) (failure "',' or something" t))) (glisp::deletedecisionpoint)) (setq glisp::!dest (glisp::xnew)) (glisp::rbeginlist) (setq glisp::!dest (glisp::xcons glisp::!dest (quote defconstant))) (glisp::srvariable 1) (glisp::srvariable 2) (glisp::rendlist) (case (glisp::altcheck 3) (1 (setq glisp::!dest (glisp::xcons glisp::!dest (quote \;))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote constant)))) (2) (t (failure "';' or something"))) (glisp::endplispfunction (quote aconstant))) ((call nonreservedword) (variable 1) (literal \:=) (call simpleexpression) (variable 2) (alternatives 3 ((literal \,)) nil) (rewritesto) (beginlist) (literal defconstant) (variable 1) (variable 2) (endlist) (alternatives 3 ((literal \;) (literal constant)) nil))) (defpfun braceexpression nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote braceexpression)) (glisp::lcall (quote sourcelanguage) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote mlisp))) (cdr glisp::!dest)) nil) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (glisp::lcall (quote sourcelanguage) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote plisp))) (cdr glisp::!dest)) nil) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) (glisp::endplispfunction (quote braceexpression))) ((call sourcelanguage ((literal mlisp))) (call expression) (variable 1) (call sourcelanguage ((literal plisp))) (rewritesto) (variable 1))) (defpfun mlispfunction nil (let (glisp::!dest glisp::!variables glisp::!inrepeat) (glisp::beginplispfunction (quote mlispfunction)) (glisp::lcall (quote sourcelanguage) (let ((glisp::!dest (glisp::xnew))) (setq glisp::!dest (glisp::xcons glisp::!dest (quote mlisp))) (cdr glisp::!dest)) nil) (glisp::lcall (quote expression) nil nil) (glisp::slvariable 1) (or (nextis? (quote \;)) (failure "';'")) (setq glisp::!dest (glisp::xnew)) (glisp::srvariable 1) (glisp::endplispfunction (quote mlispfunction))) ((call sourcelanguage ((literal mlisp))) (call expression) (variable 1) (literal \;) (rewritesto) (variable 1))) (defun prefixes (&aux (token (peek))) (cond ((and (symbolp token) (get token (quote prefix))) (next) (cond ((eq (peek) !lparen) (setf !source (xprepend (list token) !source)) nil) (t (cons token (prefixes))))) (t nil))) (defun precedence (rbp e &aux (op (peek))) (cond ((not (symbolp op)) (failure "a symbol")) ((> rbp (bindingpower op (quote left))) e) (t (next) (precedence rbp (compose op e (precedence (bindingpower op (quote right)) (pcall (quote basicexpression) nil))))))) (defun bindingpower (op ind) (or (get op ind) (and (get op (quote mlisp)) (- 1)) (and (get op (quote delimiter)) (- 1)) (get (quote default) ind))) (defun compose (fn e1 e2) (cond ((not (get fn (quote associative))) (list fn e1 e2)) ((and (consp e1) (eq (car e1) fn)) (cond ((and (consp e2) (eq (car e2) fn)) (append e1 (cdr e2))) (t (append e1 (list e2))))) ((and (consp e2) (eq (car e2) fn)) (cons fn (cons e1 (cdr e2)))) (t (list fn e1 e2)))) (defun composition (fns ex) (cond ((null fns) ex) (t (list (car fns) (composition (cdr fns) ex))))) (defun makekeyword (id) (intern (symbol-name id) (quote keyword))) (defun makeprogn (l) (cond ((null (cdr l)) (car l)) (t (cons (quote progn) l)))) (defun translateindex (ex l) (cond ((null l) ex) ((integerp (car l)) (translateindex (numericindex (car l) ex) (cdr l))) (t (translateindex (list (quote nth) (list (quote -) (car l) 1) ex) (cdr l))))) (defun numericindex (n ex) (cond ((< n 1) ex) ((> n 10) (list (quote nth) (- n 1) ex)) (t (list (nth (- n 1) (quote (car cadr caddr cadddr fifth sixth seventh eighth ninth tenth))) ex)))) (defun numericforvariable (var min max step) (prog ((max2 (cond ((not (numberp max)) (intern (cat "&" (cat var "&")))) (t nil))) (step2 (cond ((not (numberp step)) (intern (cat "&&" (cat var "&&")))) (t nil)))) (return (append (list (list var min (list (quote +) var (or step2 step)))) (and max2 (list (list max2 max))) (and step2 (list (list step2 step))))))) (defun numericforstoptest (var max step) (prog nil (cond ((not (numberp max)) (setf max (intern (cat "&" (cat var "&")))))) (cond ((not (numberp step)) (setf step (intern (cat "&&" (cat var "&&")))))) (return (cond ((not (numberp step)) (list (list (quote and) (list (quote >) step 0) (list (quote >) var max)) (list (quote and) (list (quote <) step 0) (list (quote <) var max)) (list (quote and) (list (quote =) step 0) (quote (error "increment = 0 in Mlisp FOR loop"))))) ((> step 0) (list (list (quote >) var max))) ((< step 0) (list (list (quote <) var max))) (t (perror "increment = 0 in FOR loop")))))) (defun reparsemlisp (name filename &key (target nil) (package nil)) (reparse name filename :source (quote mlisp) :target target :parser (quote mlispfunction) :locater (quote locatemlispfunction) :readtable *glisp-readtable* :package package)) (defun locatemlispfunction (name stream *readtable*) (prog ((x (quote \;)) index foundit) (do (glisp::&v) ((and (or (eq x (quote \;)) (eq x (quote -)) (eq x !eof)) (case x (\; (prog nil (setf index (file-position stream)) (setf foundit (and (member (read stream nil !eof nil) (quote (defun defmacro defobfun))) (eq (read stream nil !eof nil) name))) (file-position stream index) (return foundit))) (- (prog nil (setf index (file-position stream)) (setf foundit (and (eq (read stream nil !eof nil) (quote mlisp)) (eq (read stream nil !eof nil) (quote -)) (setf index (file-position stream)) (member (read stream nil !eof nil) (quote (defun defmacro defobfun))) (eq (read stream nil !eof nil) name))) (file-position stream index) (return foundit))) (otherwise t))) (return glisp::&v)) (setq glisp::&v (setf x (read stream nil !eof nil)))) (return (neq x !eof)))) 
